Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/demoinit.pas

Pascal/Delphi Source File | 1994-07-25 | 8.6 KB | 538 lines

UNIT DEMOINIT;
{
  THIS UNIT WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.

  This is it.
  All usefull sub-routines are collected here.
  Look around and you'll probably find something.
}

INTERFACE

{$S-,F-,B-}

uses
    DOS;

const
    {screen constants}
    WIDTH = 80;
    HEIGHT = 200;
    SCRSIZE = 65528;
    {assmebler '386 opcode prefixes}
    FS = $64;
    GS = $65;
    LONG = $66;

type
    pScreen = ^ScreenType;
    ScreenType = array[0..SCRSIZE] of byte;

var
    Key : char;
    ytabel : array[0..240] of word;
    keyhit : array[0..127] of byte;
    retraces : word;
    total_retraces : word;
    {pointer to user-interrupt hook}
    timerproc : procedure;
    {store old interrupt-pointers}
    Int08Save : procedure;
    Int09Save : procedure;


procedure OpenScreen;
procedure InModeX;
procedure CloseScreen;
procedure ClearWholeScreen;
procedure VBLANK;
procedure VBLANK_QUICK;
procedure Screen_On;
procedure Screen_Off;
procedure SetAddress(a : pointer);
procedure SetHorizOfs(count : byte);
procedure SetRGB(color : integer; r,g,b : byte);
procedure SetBitplanes(planes : byte);
inline(
    $BA/$C4/$03/    {mov    dx,$3C4}
    $58/                {pop    ax}
    $88/$C4/            {mov    ah,al}
    $B0/$02/            {mov    al,$02}
    $EF);                {out    dx,ax}
procedure SetWriteMode(m : byte);
procedure SetLineRepeat(nr:Byte);
procedure CLI; inline($FA);
procedure STI; inline($FB);

procedure SetPixel(page : word; x,y : integer; color : byte);

procedure SetAllInterrupts;
procedure RestoreAllInterrupts;
procedure SetKbdInterrupt;
procedure RestoreKbdInterrupt;
procedure SetTimerInterrupt;
procedure RestoreTimerInterrupt;

function  KeyPressed : boolean;

function LongDiv(X: longint; Y: Integer) : Integer;
inline($59/$58/$5A/$F7/$F9);
function LongMul(X, Y : integer) : longint;
inline($5A/$58/$F7/$EA);



(*-----------------------------------------*)

IMPLEMENTATION

const
    TIMESET = 2610; {2838 / 2610}
    TIMEOUT = 7;
    keymap : string = ' e1234567890-=  QWERTYUIOP[]  ASDFGHJKL;`\  ZXCVBNM,./                                                   ';

var
    OldScreenMode : byte;
    OldExitProc : pointer;

    SpecialKeys : byte;
    timercount : integer;

    KeyInstalled : boolean;
    TimerInstalled : boolean;

(*-----------------------------------------*)

{$F+}
procedure ScreenExitProc;
begin
  ExitProc:=OldExitProc;
  CloseScreen;
end;
{$F-}

procedure OpenScreen; { Setup Tweak-VGA screen }
var
    i : integer;
begin
    for i:=0 to 240 do ytabel[i]:=i*WIDTH;

    asm
        mov    ah,$0F                    { Fetch the current videomode }
        int    $10                        { and save it }
        mov    OldScreenMode,al

        mov    ax,$13                    { Init 320*200 screen }
        int    $10

        cli                                { Setup TWEAK-VGA }
        mov    dx,$3C4
        mov    al,4
        out    dx,al
        inc    dx
        in        al,dx
        and    al,$F7
        or        al,4
        out    dx,al

        mov    dx,$3CE
        mov    al,5
        out    dx,al
        inc    dx
        in        al,dx
        and    al,$EF
        out    dx,al

        dec    dx
        mov    al,6
        out    dx,al
        inc    dx
        in        al,dx
        and    al,$FD
        out    dx,al

        mov    dx,$3D4
        mov    al,$14
        out    dx,al
        inc    dx
        in        al,dx
        and    al,$BF
        out    dx,al

        dec    dx
        mov    al,$17
        out    dx,al
        inc    dx
        in        al,dx
        or        al,$40
        out    dx,al
        sti
    end;

    OldExitProc:=ExitProc;
    ExitProc:=@ScreenExitProc;
end;

procedure CloseScreen;
begin
    asm
        xor    ah,ah    { Set the old videomode }
        mov    al,OldScreenMode
        mov    al,3 {-- overload OldScreenMode and force 80*25-mode}
        int    $10
    end;
    Writeln;
    Writeln('A small piece of code by Bjarke Viksφe...');
end;

procedure InModeX;
begin
    CLI;
    Port[$3C2]:=$E3;
    PortW[$3D4]:=$2C11;
    PortW[$3D4]:=$0D06;
    PortW[$3D4]:=$3E07;
    PortW[$3D4]:=$EA10;
    PortW[$3D4]:=$AC11;
    PortW[$3D4]:=$DF12;
    PortW[$3D4]:=$E715;
    PortW[$3D4]:=$0616;
    STI;
end;


(*-----------------------------------------*)

procedure VBLANK; assembler;
asm
    cmp    TimerInstalled,TRUE
    je        @timerinstalled
    mov    dx,3DAh
@vent1:
    in        al,dx
    test    al,8
    jz        @vent1
    cli
@vent2:
    in        al,dx
    test    al,8
    jnz    @vent2
    sti
    jmp    NEAR PTR @done

@timerinstalled:
    mov    ax,total_retraces
@vent3:
    cmp    ax,total_retraces
    je        @vent3
@done:
end;

procedure VBLANK_QUICK; assembler;
asm
    cmp    TimerInstalled,TRUE
    je        @timerinstalled
    cli
    mov     dx,3DAh
@vent1:
    in      al,dx
    test    al,8
    jz         @vent1
    sti
    jmp    NEAR PTR @done

@timerinstalled:
    mov    ax,total_retraces
@vent2:
    cmp    ax,total_retraces
    je        @vent2
@done:
end;

procedure SCREEN_OFF; assembler;
asm
    cli
    mov    dx,$3C4
    mov    al,$01
    out    dx,al
    inc    dx
    in        al,dx
    or        al,$20
    out    dx,al
    sti
end;

procedure SCREEN_ON; assembler;
asm
    cli
    mov    dx,$3C4
    mov    al,$01
    out    dx,al
    inc    dx
    in        al,dx
    and    al,$DF
    out    dx,al
    sti
end;

procedure SetAddress(a : pointer); assembler;
asm
    cli
    mov bx,WORD PTR a
    mov dx,$3d4
    mov al,$c
    mov ah,bh
    out dx,ax
    inc ax
    mov ah,bl
    out dx,ax
    sti
end;

procedure SetHorizOfs(count : byte);
var
    i : byte;
begin
    i:=Port[$3DA];
    Port[$3C0]:=$33;
    Port[$3C0]:=Count SHL 1;
end;

procedure SetRGB(color : integer; r,g,b : byte); assembler;
asm
    cli
    mov    dx,$3C8
    mov    ax,color
    out    dx,al
    inc    dx
    mov    al,r
    out    dx,al
    mov    al,g
    out    dx,al
    mov    al,b
    out    dx,al
    sti
end;


procedure SetPixel(page : word; x,y : integer; color : byte); assembler;
asm
    cli
    mov    dx,$3C4
    mov    al,$02
    mov    ah,1
    mov    cx,x
    and    cl,11b
    shl    ah,cl
    out    dx,ax
    sti

    mov    es,SEGA000
    mov    bx,y
    add    bx,bx
    mov    di,[OFFSET ytabel+bx]
    add    di,page
    mov    ax,x
    shr    ax,2
    add   di,ax
    mov    al,color
    mov    [es:di],al
end;

procedure SetLineRepeat(nr:Byte);
begin
    Port[$3D4]:=9;
    Port[$3D5]:=Port[$3D5] AND $F0+nr;
end;

procedure SetWriteMode(m : byte);
begin
    Port[$3CE]:=$05;
    Port[$3CF]:=(Port[$3CF] AND $FC) OR (m AND 3);
end;


(*-----------------------------------------*)


procedure ClearWholeScreen; assembler;      { clear most of videomemory }
asm
    cli
    mov    dx,$3C4
    mov    ax,$0F02
    out    dx,ax
    sti
    mov    es,SEGA000
    xor    di,di
    mov    cx,($10000/4)-1
    DB LONG; xor ax,ax
    cld
    rep; DB LONG; stosw;
end;

procedure SetTimer(x : word); assembler;
asm
    cli
    mov    al,$36
    out    $43,al
    mov    ax,x
    out    $40,al
    mov    al,ah
    out    $40,al
    sti
end;

(*-----------------------------------------*)

{$F+}
procedure KbdHandler; interrupt; assembler;
{$F-}
asm
    in        al,$60
    mov    bl,al

    in        al,$61
    or        al,$80
    out    $61,al
    and    al,$7F
    out    $61,al

    cmp    al,$E0
    jne    @notE0
    add    SpecialKeys,1
    jmp   @done
@notE0:
    cmp    al,$E1
    jne    @notE1
    add    SpecialKeys,2
    jmp    @done
@notE1:
    cmp    SpecialKeys,0
    jz        @nospeckey
    dec    SpecialKeys
    jmp    @done
@nospeckey:

    mov    al,bl
    and    bx,$7F
    inc    bx
    cmp    bl,110    {array is only about 110 chars long...}
    ja        @done
    and    al,al
    jns    @pressin
    mov    BYTE PTR [bx+OFFSET keyhit],0
    mov    al,[bx+OFFSET keymap]
    mov    Key,al
    jmp    NEAR PTR @done
@pressin:
    mov    BYTE PTR [bx+OFFSET keyhit],1
@done:
    sti
    mov    al,$20
    out    $20,al
end;

{$F+,S-}
procedure TimerHandler; interrupt; assembler;
{$F-}
asm
    inc    timercount
    cmp    timercount,TIMEOUT
    jb        @noretrace
    mov    timercount,0
    mov    dx,$3DA
@vblank:
    in        al,dx
    test    al,$08
    je        @vblank

    mov    al,$36
    out    $43,al
    mov    ax,TIMESET
    out    $40,al
    mov    al,ah
    out    $40,al

{here comes timer code...}
    inc    retraces
    inc    total_retraces

    mov    ax,WORD PTR TimerProc
    or        ax,WORD PTR TimerProc+2
    je        @nouserproc
{$F+}
    call    TimerProc
{$F-}
@nouserproc:

@noretrace:
    mov    al,$20
    out    $20,al
    sti
end;


procedure SetTimerInterrupt;
begin
    retraces:=0;
    total_retraces:=0;
    timercount:=0;
    GetIntVec($08,@Int08Save);
    SetIntVec($08,addr(TimerHandler));
    SetTimer(TIMESET);
    TimerInstalled:=TRUE;
end;

procedure RestoreTimerInterrupt;
begin
    SetIntVec($08,@Int08Save);
    SetTimer(0);
    TimerInstalled:=FALSE;
end;

procedure SetKbdInterrupt;
var
    i : integer;
begin
    Key:=#0;
    SpecialKeys:=0;
    for i:=1 to sizeof(keyhit) do keyhit[i]:=0;
    GetIntVec($09,@Int09Save);
    SetIntVec($09,addr(KbdHandler));
    KeyInstalled:=TRUE;
end;

procedure RestoreKbdInterrupt;
begin
    SetIntVec($09,@Int09Save);
    KeyInstalled:=FALSE;
end;

procedure SetAllInterrupts;
begin
    SetTimerInterrupt;
    SetKbdInterrupt;
    Port[$21]:=$5C; {Turns off IRQ 2,3,4, and 6}
end;

procedure RestoreAllInterrupts;
begin
    RestoreTimerInterrupt;
    RestoreKbdInterrupt;
    Port[$21]:=0; {Let all IRQ's live}
end;

function KeyPressed : boolean;    { test if key has been struck }
begin
    if (KeyInstalled) then KeyPressed:=Key<>#0
    else KeyPressed:=Port[$60]<$80;
end;

begin
    TimerProc:=NIL;
    TimerInstalled:=FALSE;
    KeyInstalled:=FALSE;
end.